home *** CD-ROM | disk | FTP | other *** search
/ PC-X 1997 October / pcx14_9710.iso / swag / misc.swg / 0175_Another Percentage bar.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  2.1 KB  |  74 lines
  1. {
  2. Someone asked for a percentagebar routine. Well, here's a little one I put
  3. together. (Put it in SWAG if you like...)
  4. There's a testprogram at the end...
  5. }
  6.  
  7. UNIT PERC_BAR;
  8. INTERFACE
  9.  
  10. PROCEDURE InitBar(Xpos,Ypos,Size,ForCol,BackCol:BYTE);
  11. PROCEDURE UpdateBar(Curr:BYTE);
  12.  
  13. IMPLEMENTATION
  14. CONST
  15.   SCSEG          = $B800;               (* Segment for screen *)
  16.   SCWIDTH        = 80*2;                (* Width of screen *)
  17.  
  18. VAR (* Local variables *)
  19.   BarOffs        : WORD;
  20.   BarSize        : BYTE;
  21.   BarCol         : BYTE;
  22.  
  23. (*************************************************************************
  24. (* Name    : InitBar(Xpos,Ypos,Size,ForCol,BackCol:BYTE)
  25. (* Purpose : Initializes the percentage bar. Xpos,Ypos is absolute posi-
  26. (*           tion on screen, Size is how wide the bar is and ForCol and
  27. (*           BackCol are the colors to use
  28. (* Returns : None
  29. (*************************************************************************)
  30. PROCEDURE InitBar(Xpos,Ypos,Size,ForCol,BackCol:BYTE);
  31. VAR
  32.   ix             : BYTE;
  33.   wValue         : WORD;
  34. BEGIN
  35.   BarOffs:=(Xpos-1)*2+(Ypos-1)*SCWIDTH;
  36.   BarSize:=Size;
  37.   BarCol:=BackCol*16+ForCol;
  38.   wValue:=ORD('▓')+BarCol*256;
  39.   FOR ix:=0 TO BarSize-1 DO
  40.     MEMW[SCSEG:BarOffs+ix*2]:=wValue;
  41. END; (* InitBar(Xpos,Ypos,Size,ForCol,BackCol:BYTE) *)
  42.  
  43. (***************************************************************************
  44. (* Name    : UpdateBar(Curr:BYTE)
  45. (* Purpose : Updates the bar with the current percentage. Curr is a percen-
  46. (*           tage value between 0 and 100.
  47. (* Returns : None
  48. (***************************************************************************)
  49. PROCEDURE UpdateBar(Curr:BYTE);
  50. VAR
  51.   ix             : INTEGER;
  52.   pSize          : INTEGER;
  53.   wValue         : WORD;
  54. BEGIN
  55.   pSize:=TRUNC((Curr/100)*BarSize);
  56.   wValue:=ORD('█')+BarCol*256;
  57.   FOR ix:=0 TO pSize-1 DO
  58.     MEMW[SCSEG:BarOffs+ix*2]:=wValue;
  59. END; (* UpdateBar(Curr:BYTE) *)
  60.  
  61. END.
  62.  
  63. (* Here is a little test program *)
  64. PROGRAM PercTest;
  65. USES Perc_Bar;
  66.  
  67. VAR
  68.   count          : WORD;
  69. BEGIN
  70.   InitBar(30,10,20,14,1);
  71.   FOR count:=1 TO 10000 DO
  72.     UpdateBar(TRUNC((count/10000)*100));
  73. END.
  74.